Programmer Plus 2007/Programmer-Plus-2007.iso/Programming/Visual Basic new SourceCode and Projects/Adventure game/mdi.frm

Visual Basic Form | 1999-05-21 | 20.5 KB | 612 lines

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{38911DA0-E448-11D0-84A3-00DD01104159}#1.1#0"; "COMCT332.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.MDIForm frmMDI
   BackColor       =   &H00808080&
   Caption         =   "Adventure Game Creator"
   ClientHeight    =   8310
   ClientLeft      =   915
   ClientTop       =   2205
   ClientWidth     =   11880
   Icon            =   "mdi.frx":0000
   LinkTopic       =   "MDIForm1"
   MousePointer    =   99  'Custom
   StartUpPosition =   2  'CenterScreen
   WindowState     =   2  'Maximized
   Begin VB.Timer Timer8
      Enabled         =   0   'False
      Interval        =   100
      Left            =   3600
      Top             =   0
   End
   Begin ComCtl3.CoolBar CoolBar1
      Align           =   1  'Align Top
      Height          =   420
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   11880
      _ExtentX        =   20955
      _ExtentY        =   741
      BandCount       =   2
      BackColor       =   12632256
      _CBWidth        =   11880
      _CBHeight       =   420
      _Version        =   "6.0.8169"
      MinWidth1       =   7995
      MinHeight1      =   360
      Width1          =   9000
      NewRow1         =   0   'False
      Child2          =   "ProgressBar1"
      MinWidth2       =   1995
      MinHeight2      =   255
      Width2          =   1995
      NewRow2         =   0   'False
      Begin VB.Timer Timer6
         Enabled         =   0   'False
         Interval        =   100
         Left            =   1920
         Top             =   0
      End
      Begin VB.Timer Timer7
         Enabled         =   0   'False
         Interval        =   100
         Left            =   2280
         Top             =   0
      End
      Begin VB.Timer Timer5
         Enabled         =   0   'False
         Interval        =   100
         Left            =   1560
         Top             =   0
      End
      Begin VB.Timer Timer4
         Enabled         =   0   'False
         Interval        =   100
         Left            =   1200
         Top             =   0
      End
      Begin VB.Timer Timer2
         Enabled         =   0   'False
         Interval        =   100
         Left            =   480
         Top             =   0
      End
      Begin VB.Timer Timer3
         Enabled         =   0   'False
         Interval        =   100
         Left            =   840
         Top             =   0
      End
      Begin VB.Timer Timer1
         Enabled         =   0   'False
         Interval        =   100
         Left            =   120
         Top             =   0
      End
      Begin MSComctlLib.ProgressBar ProgressBar1
         Height          =   255
         Left            =   9195
         TabIndex        =   3
         Top             =   75
         Width           =   2595
         _ExtentX        =   4577
         _ExtentY        =   450
         _Version        =   393216
         Appearance      =   1
      End
   End
   Begin VB.PictureBox picToolbar
      Align           =   1  'Align Top
      BackColor       =   &H00FFFFFF&
      BeginProperty Font
         Name            =   "Times New Roman"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      Left            =   0
      ScaleHeight     =   345
      ScaleMode       =   0  'User
      ScaleWidth      =   11820
      TabIndex        =   0
      Top             =   420
      Width           =   11880
      Begin MSComDlg.CommonDialog CMDialog1
         Left            =   5880
         Top             =   0
         _ExtentX        =   847
         _ExtentY        =   847
         _Version        =   393216
         CancelError     =   -1  'True
         DefaultExt      =   "TXT"
         Filter          =   $"mdi.frx":030A
         FilterIndex     =   557
         FontSize        =   1.27584e-37
      End
      Begin VB.Image imgCalcButton
         Height          =   225
         Left            =   11000
         Picture         =   "mdi.frx":03A3
         Top             =   70
         Width           =   240
      End
      Begin VB.Image imgExitButton
         Height          =   225
         Left            =   11520
         Picture         =   "mdi.frx":08D5
         Top             =   75
         Width           =   240
      End
      Begin VB.Image imgAboutButton
         Height          =   240
         Left            =   11280
         Picture         =   "mdi.frx":0E07
         ToolTipText     =   "About AGC"
         Top             =   60
         Width           =   240
      End
      Begin VB.Image imgPasteButtonUp
         Height          =   225
         Left            =   5640
         Picture         =   "mdi.frx":0F09
         Top             =   45
         Visible         =   0   'False
         Width           =   240
      End
      Begin VB.Image imgPasteButtonDn
         Height          =   225
         Left            =   5280
         Picture         =   "mdi.frx":143B
         Top             =   45
         Visible         =   0   'False
         Width           =   240
      End
      Begin VB.Image imgCopyButtonDn
         Height          =   225
         Left            =   4560
         Picture         =   "mdi.frx":196D
         Top             =   60
         Visible         =   0   'False
         Width           =   240
      End
      Begin VB.Image imgCopyButtonUp
         Height          =   225
         Left            =   4920
         Picture         =   "mdi.frx":1E9F
         Top             =   60
         Visible         =   0   'False
         Width           =   240
      End
      Begin VB.Image imgCutButtonDn
         Height          =   225
         Left            =   4200
         Picture         =   "mdi.frx":23D1
         Top             =   45
         Visible         =   0   'False
         Width           =   240
      End
      Begin VB.Image imgCutButtonUp
         Height          =   225
         Left            =   3960
         Picture         =   "mdi.frx":2903
         Top             =   45
         Visible         =   0   'False
         Width           =   240
      End
      Begin VB.Image imgFileOpenButtonDn
         Height          =   225
         Left            =   3360
         Picture         =   "mdi.frx":2E35
         Top             =   45
         Visible         =   0   'False
         Width           =   240
      End
      Begin VB.Image imgFileOpenButtonUp
         Height          =   225
         Left            =   3720
         Picture         =   "mdi.frx":3367
         Top             =   45
         Visible         =   0   'False
         Width           =   240
      End
      Begin VB.Image imgFileNewButtonUp
         Height          =   300
         Left            =   3000
         Picture         =   "mdi.frx":3899
         Top             =   30
         Visible         =   0   'False
         Width           =   315
      End
      Begin VB.Image imgFileNewButtonDn
         Height          =   300
         Left            =   2760
         Picture         =   "mdi.frx":3A0B
         Top             =   30
         Visible         =   0   'False
         Width           =   315
      End
      Begin VB.Image imgPasteButton
         Height          =   225
         Left            =   1560
         Picture         =   "mdi.frx":3B7D
         ToolTipText     =   "Paste"
         Top             =   45
         Width           =   240
      End
      Begin VB.Image imgCopyButton
         Height          =   225
         Left            =   1200
         Picture         =   "mdi.frx":40AF
         ToolTipText     =   "Copy"
         Top             =   60
         Width           =   240
      End
      Begin VB.Image imgCutButton
         Height          =   225
         Left            =   840
         Picture         =   "mdi.frx":45E1
         ToolTipText     =   "Cut"
         Top             =   45
         Width           =   240
      End
      Begin VB.Image imgFileOpenButton
         Height          =   225
         Left            =   440
         Picture         =   "mdi.frx":4B13
         ToolTipText     =   "Open File"
         Top             =   45
         Width           =   240
      End
      Begin VB.Image imgFileNewButton
         Height          =   300
         Left            =   0
         Picture         =   "mdi.frx":5045
         ToolTipText     =   "New File"
         Top             =   30
         Width           =   315
      End
   End
   Begin MSComctlLib.StatusBar StatusBar1
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   1
      Top             =   7935
      Width           =   11880
      _ExtentX        =   20955
      _ExtentY        =   661
      Style           =   1
      SimpleText      =   "Status: Normal"
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
         NumPanels       =   2
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
            Bevel           =   0
            Object.Width           =   19
            MinWidth        =   19
            Object.Tag             =   "Tab1"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
            Text            =   "Status = Normal"
            TextSave        =   "Status = Normal"
         EndProperty
      EndProperty
      OLEDropMode     =   1
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileNew
         Caption         =   "&New"
      End
      Begin VB.Menu mnuFileOpen
         Caption         =   "&Open"
      End
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
      Begin VB.Menu mnuSeparator
         Caption         =   "-"
      End
      Begin VB.Menu mnuRecentFile
         Caption         =   "-"
         Index           =   0
         Visible         =   0   'False
      End
      Begin VB.Menu mnuRecentFile
         Caption         =   "RecentFile1"
         Index           =   1
         Visible         =   0   'False
      End
      Begin VB.Menu mnuRecentFile
         Caption         =   "RecentFile2"
         Index           =   2
         Visible         =   0   'False
      End
      Begin VB.Menu mnuRecentFile
         Caption         =   "RecentFile3"
         Index           =   3
         Visible         =   0   'False
      End
      Begin VB.Menu mnuRecentFile
         Caption         =   "RecentFile4"
         Index           =   4
         Visible         =   0   'False
      End
      Begin VB.Menu mnuRecentFile
         Caption         =   "RecentFile5"
         Index           =   5
         Visible         =   0   'False
      End
   End
   Begin VB.Menu mnuOptions
      Caption         =   "&Options"
      Begin VB.Menu mnuOptionsToolbar
         Caption         =   "&Toolbar"
      End
   End
   Begin VB.Menu mnuTools
      Caption         =   "&Tools"
      Begin VB.Menu mnuToolsCalculator
         Caption         =   "&Calculator"
      End
      Begin VB.Menu mnuToolsCompilerDirectives
         Caption         =   "&Compiler Directives"
      End
   End
   Begin VB.Menu mnuHelp
      Caption         =   "&Help"
      Begin VB.Menu mnuHelpAbout
         Caption         =   "&About"
      End
   End
Attribute VB_Name = "frmMDI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*** Main MDI form for MDI Notepad sample       ***
'*** application.                               ***
'**************************************************
Option Explicit
Private Sub imgAboutButton_Click()
frmAbout.Show
End Sub
Private Sub imgCalcButton_Click()
Calculator.Show
End Sub
Private Sub imgCopyButton_Click()
    ' Refresh the image.
    imgCopyButton.Refresh
    ' Call the copy procedure
    EditCopyProc
End Sub
Private Sub imgCopyButton_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Show the picture for the down state.
    imgCopyButton.Picture = imgCopyButtonDn.Picture
End Sub
Private Sub imgCopyButton_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' If the button is pressed, display the up bitmap when the
    ' mouse is dragged outside the button's area; otherwise
    ' display the down bitmap.
    Select Case Button
    Case 1
        If X <= 0 Or X > imgCopyButton.Width Or Y < 0 Or Y > imgCopyButton.Height Then
            imgCopyButton.Picture = imgCopyButtonUp.Picture
        Else
            imgCopyButton.Picture = imgCopyButtonDn.Picture
        End If
    End Select
End Sub
Private Sub imgCopyButton_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Show the picture for the up state.
    imgCopyButton.Picture = imgCopyButtonUp.Picture
End Sub
Private Sub imgCutButton_Click()
    ' Refresh the image.
    imgCutButton.Refresh
    ' Call the cut procedure
    EditCutProc
End Sub
Private Sub imgCutButton_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Show the picture for the down state.
    imgCutButton.Picture = imgCutButtonDn.Picture
End Sub
Private Sub imgCutButton_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' If the button is pressed, display the up bitmap when the
    ' mouse is dragged outside the button's area; otherwise,
    ' display the down bitmap.
    Select Case Button
    Case 1
        If X <= 0 Or X > imgCutButton.Width Or Y < 0 Or Y > imgCutButton.Height Then
            imgCutButton.Picture = imgCutButtonUp.Picture
        Else
            imgCutButton.Picture = imgCutButtonDn.Picture
        End If
    End Select
End Sub
Private Sub imgCutButton_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Show the picture for the up state.
    imgCutButton.Picture = imgCutButtonUp.Picture
End Sub
Private Sub imgExitButton_Click()
End Sub
Private Sub imgFileNewButton_Click()
    ' Refresh the image.
    imgFileNewButton.Refresh
    ' Call the new file procedure
    FileNew
End Sub
Private Sub imgFileNewButton_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Show the picture for the down state.
    imgFileNewButton.Picture = imgFileNewButtonDn.Picture
End Sub
Private Sub imgFileNewButton_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' If the button is pressed, display the up bitmap when the
    ' mouse is dragged outside the button's area; otherwise,
    ' display the down bitmap.
    Select Case Button
    Case 1
        If X <= 0 Or X > imgFileNewButton.Width Or Y < 0 Or Y > imgFileNewButton.Height Then
            imgFileNewButton.Picture = imgFileNewButtonUp.Picture
        Else
            imgFileNewButton.Picture = imgFileNewButtonDn.Picture
        End If
    End Select
End Sub
Private Sub imgFileNewButton_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Show the picture for the up state.
    imgFileNewButton.Picture = imgFileNewButtonUp.Picture
End Sub
Private Sub imgFileOpenButton_Click()
    ' Refresh the image.
    imgFileOpenButton.Refresh
    ' Call the file open procedure
    FileOpenProc
End Sub
Private Sub imgFileOpenButton_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Show the picture for the down state.
    imgFileOpenButton.Picture = imgFileOpenButtonDn.Picture
End Sub
Private Sub imgFileOpenButton_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' If the button is pressed, display the up bitmap when the
    ' mouse is dragged outside the button's area; otherwise,
    ' display the down bitmap.
    Select Case Button
    Case 1
        If X <= 0 Or X > imgFileOpenButton.Width Or Y < 0 Or Y > imgFileOpenButton.Height Then
            imgFileOpenButton.Picture = imgFileOpenButtonUp.Picture
        Else
            imgFileOpenButton.Picture = imgFileOpenButtonDn.Picture
        End If
    End Select
End Sub
Private Sub imgFileOpenButton_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Show the picture for the up state.
    imgFileOpenButton.Picture = imgFileOpenButtonUp.Picture
End Sub
Private Sub imgPasteButton_Click()
    ' Refresh the image.
    imgPasteButton.Refresh
    ' Call the paste procedure
    EditPasteProc
End Sub
Private Sub imgPasteButton_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Show the picture for the down state.
    imgPasteButton.Picture = imgPasteButtonDn.Picture
End Sub
Private Sub imgPasteButton_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' If the button is pressed, display the up bitmap when the
    ' mouse is dragged outside the button's area; otherwise,
    ' display the down bitmap.
    Select Case Button
    Case 1
        If X <= 0 Or X > imgPasteButton.Width Or Y < 0 Or Y > imgPasteButton.Height Then
            imgPasteButton.Picture = imgPasteButtonUp.Picture
        Else
            imgPasteButton.Picture = imgPasteButtonDn.Picture
        End If
    End Select
End Sub
Private Sub imgPasteButton_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Show the picture for the up state.
    imgPasteButton.Picture = imgPasteButtonUp.Picture
End Sub
Private Sub MDIForm_Load()
Timer8.Enabled = True
Timer1.Enabled = True
    ' Application starts here (Load event of Startup form).
    Show
    ' Always set the working directory to the directory containing the application.
    ChDir App.Path
    ' Initialize the document form array, and show the first document.
    ReDim FState(1)
     ReDim Document(1)
    Document(1).Tag = 1
    FState(1).Dirty = False
    ' Read System registry and set the recent menu file list control array appropriately.
    ' Set public variable gFindDirection which determines which direction
    ' the FindIt function will search in.
    gFindDirection = 1
End Sub
Private Sub mnuFileExit_Click()
    ' End the application.
    End
End Sub
Private Sub mnuFileNew_Click()
Timer6.Enabled = True
    ' Call the new file procedure
    FileNew
End Sub
Private Sub mnuFileOpen_Click()
    ' Call the file open procedure.
    FileOpenProc
End Sub
Private Sub mnuHelpAbout_Click()
frmAbout.Show
End Sub
Private Sub mnuOptions_Click()
    ' Toggle the visibility of the toolbar.
    mnuOptionsToolbar.Checked = frmMDI.picToolbar.Visible
End Sub
Private Sub mnuOptionsToolbar_Click()
    ' Call the toolbar procedure, passing a reference
    ' to this form.
    OptionsToolbarProc Me
End Sub
Private Sub mnuRecentFile_Click(Index As Integer)
    ' Call the file open procedure, passing a
    ' reference to the selected file name
    OpenFile (mnuRecentFile(Index).Caption)
    ' Update the list of the most recently opened files.
    GetRecentFiles
End Sub
Private Sub mnuToolsCalculator_Click()
Calculator.Show
End Sub
Private Sub mnuToolsCompilerDirectives_Click()
CDir.Show
End Sub
Private Sub Timer1_Timer()
ProgressBar1.Value = 25
Timer2.Enabled = True
Timer1.Enabled = False
End Sub
Private Sub Timer2_Timer()
ProgressBar1.Value = 50
Timer3.Enabled = True
Timer2.Enabled = False
End Sub
Private Sub Timer3_Timer()
ProgressBar1.Value = 75
Timer4.Enabled = True
Timer3.Enabled = False
End Sub
Private Sub Timer4_Timer()
ProgressBar1.Value = 100
Timer5.Enabled = True
Timer4.Enabled = False
End Sub
Private Sub Timer5_Timer()
ProgressBar1.Value = 0
Timer5.Enabled = False
End Sub
Private Sub Timer6_Timer()
ProgressBar1.Value = 100
Timer7.Enabled = True
Timer6.Enabled = False
End Sub
Private Sub Timer7_Timer()
ProgressBar1.Value = 0
Timer7.Enabled = False
End Sub
Private Sub Timer8_Timer()
frmTip.Show
Timer8.Enabled = False
End Sub